

; World
; stores a list of objects, handles map and physics


(load "optimization.scm")
(load "globals.scm")
(load "vector.scm")
(require scheme) ; for for



(define world%
  (class object%
    
    ; PRIVATE VARIABLES
    (define quit #f)
    (define map            #f)
    (define map-background #f)
    (define map-collision  #f)
    (define map-dc            (new bitmap-dc%))
    (define map-background-dc (new bitmap-dc%))
    (define width  0)
    (define height 0)
    (define objects    '())
    (define new-object #f)
    
    
    ; GETTERS
    (define/public (get-width)  width)
    (define/public (get-height) height)
    
    
    ; DRAWABLE
    ; Draw
    (define/public (draw dc)
      ; Draw map
      (send dc draw-bitmap map 0 0)
      ;Loop through and draw objects
      (mfor-each (lambda (object)
                   (send object draw dc))
                 objects)
      ; debug
      (when *debug* (debug dc (string-append "number of objects: " (number->string (mlength objects))))))
    
    
    
    
    ; Load Map
    (define/public (load-map basename)
      ; load map
      (set! map (make-object bitmap% (string-append *maps-folder* basename *resource-file-extension*)))
      (set! width  (send map get-width))
      (set! height (send map get-height))
      (send map-dc set-bitmap map)
      ; load background
      (set! map-background (make-object bitmap% (string-append *maps-folder* basename *maps-background-extension* *resource-file-extension*)))
      (send map-background-dc set-bitmap map-background)
      ; collision
      (let* ([collision-bitmap (make-object bitmap% (string-append *maps-folder* basename *maps-collision-extension* *resource-file-extension*))]
             [collision-data   (make-bytes (* 4 width height))])
        ; get bytes
        (send collision-bitmap get-argb-pixels 0 0 width height collision-data)
        ; loop through data and fill vector accordingly
        (set! map-collision (make-vector (* width height)))
        (for ([x (in-range width)])
          (for ([y (in-range height)])
            (if (< (bytes-ref collision-data (+ 1 (fx* 4 (point->index x y width)))) *collision-limit-solid*)
                ; solid
                (vector-set! map-collision (point->index x y width) 'solid)
                (begin
                  ; destroyable
                  (vector-set! map-collision (point->index x y width) 'destroyable)
                  (when (> (bytes-ref collision-data (+ 1 (fx* 4 (point->index x y width)))) *collision-limit-destroyable*)
                    ; empty
                    (destroy x y))))))))

    
    ; Add Object
    (define/public (add-object object)
      (set! objects (mcons object objects))
      (unless new-object
        (set! new-object objects)))
    
    ; Lookup Collision
    (define/public (get-collision x y)
      (if (or (< x 0) (>= x width) (< y 0) (>= y height))
          'solid
          (vector-ref map-collision (point->index x y width))))
    
    ; Set Collision
    (define/public (set-collision x y value)
      (vector-set! map-collision (point->index x y width) value))
    
    ; Destroy
    (define/public (destroy x y)
      (when (eq? (get-collision x y) 'destroyable)
        (set-collision x y 'empty)
        (let ([pixel (new color%)])
          (send map-background-dc get-pixel x y pixel)
          (send map-dc set-pixel x y pixel))))
    
    
    
    
    ; Update
    (define/public (update)
      ; 1. Fill map-collision and generate reaction vectors for new position (for objects collided with as well as the current object)
      (mfor-each (lambda (object)
                   (when (send object interactive?)
                     (send object for-physics-space (vector-op fl+
                                                               (send object get-position)
                                                               (vector-scalar-op fl* (send object get-velocity) *time-delta*))
                           (lambda (x y new-pos-x new-pos-y)
                             (let ([collision (get-collision (+ x new-pos-x) (+ y new-pos-y))])
                               (if (eq? 'empty collision)
                                   ; if empty, fill with object
                                   (set-collision (+ x new-pos-x) (+ y new-pos-y) object)
                                   ; else interact
                                   (begin
                                     ; notify object
                                     (send object collide (+ x new-pos-x) (+ y new-pos-y) collision)
                                     ; if we hit something solid
                                     (when (or (not (object? collision)) (send collision solid?))
                                       ; set flag
                                       (send object set-collision-occured #t)
                                       ; bounce if we want to
                                       (when (send object bounce?)
                                         (send object set-reaction (vector-op fl+
                                                                              (send object get-reaction)
                                                                              (vector (fl- #i-1/2 (fixnum->flonum x))
                                                                                      (fl- #i-1/2 (fixnum->flonum y)))))))
                                     ; other object (the length of the reaction vector is based on THIS object, but it will do)
                                     (when (object? collision)
                                       ; notify object
                                       (send collision collide (+ x new-pos-x) (+ y new-pos-y) object)
                                       ; if we hit something solid
                                       (when (send object solid?)
                                         ; set flag
                                         (send collision set-collision-occured #t)
                                         ; bounce if we want to
                                         (when (send collision bounce?)
                                           (send collision set-reaction (vector-op fl-
                                                                                   (send collision get-reaction)
                                                                                   (vector (fl- #i-1/2 (fixnum->flonum x))
                                                                                           (fl- #i-1/2 (fixnum->flonum y)))))))))))))))
                 objects)
      ; 2. Clear map-collision and respond to collisions and reaction vectors
      (mfor-each (lambda (object)
                   (let ([new-velocity (if (send object affected-by-gravity?)
                                           (vector-op fl+
                                                      (send object get-velocity)
                                                      (vector 0 (fl* *gravity* *time-delta*)))
                                           (send object get-velocity))]
                         [new-position (vector-op fl+
                                                  (send object get-position)
                                                  (vector-scalar-op fl* (send object get-velocity) *time-delta*))])
                     ; remove map-collision entries for new position added in step 1
                     (when (send object interactive?)
                       (send object for-physics-space new-position
                             (lambda (x y new-pos-x new-pos-y)
                               (when (object? (get-collision (+ x new-pos-x) (+ y new-pos-y)))
                                 (set-collision (+ x new-pos-x) (+ y new-pos-y) 'empty)))))
                     ; check collision
                     (if (send object get-collision-occured)
                         ; collision
                         (if (send object bounce?)
                             ; bounce if reaction is not zero
                             (when (not (and (fl= #i0 (get-x (send object get-reaction))) (fl= #i0 (get-y (send object get-reaction)))))
                               (set! new-velocity (vector-scalar-op fl* (vector-mirror new-velocity (send object get-reaction)) *bounce-dampening*)))
                             ; no bounce
                             (send object set-position new-position))
                         ; no collision
                         (send object set-position new-position))
                     ; set new velocity
                     (send object set-velocity new-velocity)))
                 objects)
      ; 3. Call update for each object, reset per object data and remove dead objects
      (set! new-object #f)
      (let object-loop ([current objects] [prev #f])
        (unless (null? current)
          (let* ([object (mcar current)]
                 [keep #f])
            ; call object update
            (set! keep (send object update))
            ; reset object data for next frame
            (when (send object interactive?)
              (send object set-collision-list '())
              (when (send object get-collision-occured)
                (send object set-collision-occured #f)
                (send object set-reaction (make-vector 2 #i0))))
            ; remove object from list if its update returned #f
            (unless keep
              ; update prev in case we're at the beginning of the list and new objects have been added in update
              (when (and (not prev) new-object)
                (set! prev new-object))
              (if prev
                  (set-mcdr! prev    (mcdr current))
                  (set!      objects (mcdr current))))
            ; Loop to next object
            (object-loop (mcdr current) (if keep current prev)))))
      ; return
      (when (= *num-players-left* 1)
        (set! quit #t))
      (not quit))
    
    
    ; Constructor/Initialization
    (super-new)))


